Merciful 5/Merciful - Disc 5.iso/software/p/pcqpascalv1.2d.lha/Examples2/DualScroll/dualscroll.p

Text File | 1997-05-06 | 5.2 KB | 214 lines

{
  *  DualScroll, converted from Modula2 to PCQ-Pascal 03/1993 by Diesel  *
  *  Grundlage war ursprünglich ein C-Proggy von Gregg Williams.         *
  *                                     *
  *  Playfield 1 ist ein ganz normaler Intuition-Screen, Playfield 2     *
  *  dagegen eine übergroße Bitmap (640*512 Punkte ohne Interlace), die  *
  *  lustig durch die Gegend scrollt.                     *
}

Program DPFDemo;

{$I "Include:intuition/intuition.i" }
{$I "Include:graphics/areas.i" }
{$I "Include:graphics/pens.i" }
{$I "Include:exec/libraries.i" }
{$I "Include:exec/memory.i" }
{$I "Include:libraries/dos.i" }

CONST
  Farben : Array[1..32] OF Short = (
    $000, $E3F, $000, $CE7, $000, $000, $000, $000,
    $000, $FB0, $CCC, $F19, $270, $0C5, $777, $338,
    $000, $000, $000, $000, $000, $000, $000, $000,
    $000, $000, $000, $000, $000, $000, $000, $000);


VAR BMap    : BitMapPtr;            {  2. Bitmap  }
    RInfo    : ARRAY[0..1] OF RasInfo;    {  1. + 2. RasInfo  }
    RP        : ARRAY[0..1] OF RastPortPtr;    {  1. + 2. RastPort  }
    i,x,y    : INTEGER;
    ScreenDaten    : NewScreen;
    MeinScreen    : ScreenPtr;
    GfxBase    : Address;


{ -------------------------------------------------------------------- }

Function LeftMouseButton: Boolean;
Type
    bt = ^Byte;
Var
    bfe : bt;
Begin
    bfe := Address($bfe001);

    If (bfe^ MOD 128) > 64            { bit 6 gesetzt ? }
    then  LeftMouseButton := False        { ja -> nicht gedrückt }
    else  LeftMouseButton := True;        { nein -> lmb gedrückt }
end;


PROCEDURE MakeBox(x1,y1,col1,col2: INTEGER);
BEGIN
    SetAPen(  RP[1] ,0);        {  Schatten zeichnen  }
    RectFill( RP[1] ,x1+4,y1+4,x1+40,y1+40);

    SetAPen(  RP[1] ,0);        {  Umrandung zeichnen  }
    RectFill( RP[1] ,x1,y1,x1+36,y1+36);

    SetAPen(  RP[1] ,col1);        {  großen Kasten zeichnen  }
    RectFill( RP[1] ,x1+2,y1+2,x1+34,y1+34);

    SetAPen(  RP[1] ,col2);        {  kleinen Kasten zeichnen  }
    RectFill( RP[1] ,x1+12,y1+12,x1+24,y1+24);
END;    { MakeBox }


PROCEDURE ZeichneFields;
VAR x1,y1,temp,col1,col2: INTEGER;
BEGIN
                {  Fenster auf 1. Playfield malen  }
    SetRast(  RP[0], 1);    {  alles erstmal in Blau  }

    SetAPen(  RP[0], 0);
    RectFill( RP[0], 20,20,60,60);
    RectFill( RP[0], 262,195,302,235);

    SetAPen(  RP[0], 2);        { Rahmen }
    RectFill( RP[0], 95,45,225,183);

    SetAPen(  RP[0], 0);        { Fenster }
    RectFill( RP[0], 100,50,220,178);

    SetRast(  RP[1], 15);
    SetAPen(  RP[1], 14);

    temp:=1;
    FOR x1:=0 TO 640 DO {  Übergroßes Playfield 2 mit Gitter füllen  }
    BEGIN
      x1 := x1 + 19;                { Step 20 }
      Move( RP[1], x1, 0);
      Draw( RP[1], x1, 512);
    END;
    FOR y1:=0 TO 512 DO
    BEGIN
      y1 := y1 + 19;                { Step 20 }
      Move( RP[1],   0, y1 );
      Draw( RP[1], 640, y1 );
    END;

    FOR x1:=25 TO 590 DO {  Übergroßes Playfield 2 mit Kästen füllen  }
    BEGIN
      x1 := x1+49;                { Step 50 }
      FOR y1:=0 TO 462 DO
      BEGIN
    y1 := y1+49;                { Step 50 }
        col1:=temp+8;
        INC(temp);
        IF temp>7 THEN temp:=1;

        col2:=temp+8;
        INC(temp);
        IF temp>7 THEN temp:=1;

        MakeBox(x1,y1,col1,col2);
      END;
    END;
END;  { ZeichneFields }


 { ---- MAIN ---- }

BEGIN
  GfxBase := OpenLibrary( "graphics.library", 32 );
  If GfxBase=NIL THEN Exit(20);


  New( BMap );
  New( RP[0] );
  New( RP[1] );


  WITH ScreenDaten DO
  BEGIN
    leftEdge:=0;
    topEdge:=0;
    width:=322;
    height:=256;
    depth:=3;
    detailPen:=0;
    blockPen:=1;
    viewModes:= 0;
    Stype:=customScreen_f;
    defaultTitle:=NIL;
    gadgets:=NIL;
    font:=NIL;
    customBitMap:=NIL;
  END;

  MeinScreen:=OpenScreen( ADR(ScreenDaten));

  InitBitMap(BMap,3,640,512); {  Bitmap 2 initialisieren  }

  FOR i:=0 TO 2 DO
  BEGIN
    BMap^.planes[i]:=AllocRaster(640,512); {  Bitplanes reservieren  }
  END;

  InitRastPort( RP[1] );            {  RastPort 2 erstellen  }
  RP[1]^.bitMap := BMap;            {  Bitmap 2 einbinden  }

  WITH RInfo[1] DO                {  RasInfo 2 ausfüllen  }
  BEGIN
    bitMap:=BMap; rxOffset:=0; ryOffset:=0; next:=NIL;
  END;

                    {  RastPort u. RasInfo deklarieren  }
  CopyMem( Adr(MeinScreen^.SrastPort), RP[0], SizeOf(RastPort) );
  RInfo[0].next := MeinScreen^.SViewPort.rasInfo^.next;
  MeinScreen^.SviewPort.rasInfo^.next:=ADR( RInfo[1] );    {  RasInfo 2 anpassen  }

  LoadRGB4(ADR(MeinScreen^.SviewPort),ADR(Farben),32);    {  Farben laden  }

  MeinScreen^.SviewPort.modes := DualPF;        {  DUALPF setzen  }

  MakeScreen(MeinScreen);                {  erneuern  }
  RethinkDisplay;

  ZeichneFields;      {  Playfields füllen  }

  x:=1; y:=1;

  REPEAT
    RInfo[1].rxOffset:=RInfo[1].rxOffset+x;    {  Koordinaten f. PF2 erhöhen  }
    RInfo[1].ryOffset:=RInfo[1].ryOffset+y;

    IF (RInfo[1].rxOffset<=0) OR (RInfo[1].rxOffset>=319) THEN
    BEGIN
      x:=-x;
    END;

    IF (RInfo[1].ryOffset<=0) OR (RInfo[1].ryOffset>=255) THEN
    BEGIN
      y:=-y;
    END;
    RemakeDisplay;                {  Display erneuern  }
  UNTIL LeftMouseButton;

  MeinScreen^.SviewPort.rasInfo^.next := NIL;    {  Intuition-Screen setzen  }
  MeinScreen^.SviewPort.modes := 0;        {  DUALPF löschen  }

  MakeScreen(MeinScreen);            {  OK !  }
  RemakeDisplay;
  RethinkDisplay;

  CloseScreen(MeinScreen);
  FOR i:=0 TO 2 DO                {  2. Bitmap freigeben  }
  BEGIN
    FreeRaster(BMap^.planes[i],640,512);
  END;
  CloseLibrary( GfxBase );

END.